home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb40.zip / MENU.210 < prev    next >
Text File  |  1985-09-08  |  6KB  |  142 lines
  1. {**********************************************************************}
  2. {*             M E N U . 2 0 0      Menu Management Routines          *}
  3. {*                                                                    *}
  4. {*                  Separate  Out  into  File   Menu.200              *}
  5. {**********************************************************************}
  6. {----------------------------------------------------------------------}
  7. {            Max : Find Max of A or B                                  }
  8. {----------------------------------------------------------------------}
  9. Function Max (A,B :integer ) :Integer ;
  10.    Begin { Max };
  11.       If A > B then Max := A
  12.          else Max := B
  13.    End; { Max }
  14. {----------------------------------------------------------------------}
  15. {            Min : Find Min of A or B                                  }
  16. {----------------------------------------------------------------------}
  17. Function Min (A,B :integer ) :Integer ;
  18.    Begin { Min };
  19.       If A < B then Min := A
  20.          else Min := B
  21.    End; { Min }
  22.  
  23. {----------------------------------------------------------------------}
  24. {             Keyin :       Key input from keyboard                    }
  25. {----------------------------------------------------------------------}
  26.   Function Keyin: Byte;   { Single-Key Input Routine (MSDOS/PCDOS) }
  27.     Const
  28.       Esc      = #27;       { Esc key                }
  29.     Var
  30.       Ch      :char;
  31.      Begin
  32.            Read(Kbd,Ch);
  33.            if (Ch = Esc) and keypressed then
  34.               begin                    { If extended key type get }
  35.               Read(kbd,Ch);            { get next key in          }
  36.               end;
  37.            Keyin := Ord(Ch) ;          { Assign input to Output   }
  38.      End;
  39. {----------------------------------------------------------------------}
  40. {          B e e p   :  S o u n d  t h e  H o r n                      }
  41. {----------------------------------------------------------------------}
  42. Procedure Beep(N :integer);      {------------------------------------------}
  43.    Begin                         {  This routine sounds a tone of frequency }
  44.       Sound(n);                  {  N for approximately 100 ms              }
  45.       Delay(100);                {------------------------------------------}
  46.       Sound(n div 2);
  47.       Delay(100);
  48.       Nosound;
  49.       End {Beep} ;
  50. {----------------------------------------------------------------------}
  51. {          P a u s e :  Write Message and wait for keyboard            }
  52. {----------------------------------------------------------------------}
  53. Procedure Pause (Msg: ParmString);
  54.    Var
  55.       Ch   :char;
  56.     Begin
  57.     Beep(600);
  58.     Writeln(Msg);
  59.     Writeln(' Press a Key...');
  60.     Ch := Char(Keyin);
  61.     End;
  62.  
  63. {----------------------------------------------------------------------}
  64. {         M e n u  :   Generate Menu Display                           }
  65. {----------------------------------------------------------------------}
  66.  
  67. Function Menu( Input_Items: integer; var Data): integer;
  68.  
  69.   Const
  70.        {Max_Items must be specified maximum number items in menu array }
  71.  
  72.         Maxnumber= 40;        { Max Menu size          }
  73.         Downlist = 80;        { Down_arrow = Esc + 80  }
  74.         Uplist   = 72;        { Up arrow = Esc + 72    }
  75.         Select   = 13;        { Enter/Return key       }
  76.         Cancel   = 27;        { ESC key + nothing else }
  77.  
  78.     Last_Selected :integer = 1;           { Remember the last selection}
  79.  
  80.   Type
  81.      Listtype=Array[1..maxnumber] Of String[Max_String];
  82.  
  83.   Var
  84.      Item_List: Listtype absolute Data;
  85.  
  86.       Item,
  87.       Xposn,
  88.       Yposn,I : Integer;         { Selection Position    }
  89.       Chval   :byte;
  90.       x,y     :integer;
  91.  
  92.   Begin  { Menu }
  93.  
  94.     ClrScr;
  95.     Xposn := 4;
  96.     Yposn := 1;
  97.         For I := 1 to Input_Items do
  98.            Begin
  99.            GotoXY(Xposn,Yposn+I);
  100.            writeln(Item_List[I]);
  101.            end;
  102.         writeln;
  103.  
  104.     GotoXY(Xposn,Yposn+I+2);                   { Display Instructions }
  105.     writeln('Select Option with Arrow keys then press Enter');
  106.     GotoXY(Xposn,Yposn+I+4);
  107.     writeln('-  The Hunters Helper -           INSTX 2.10');
  108.  
  109.     Item := Last_Selected;             { Position to Previous Selection}
  110.     Yposn:= 1;                         { Pick menu }
  111.     Repeat
  112.       GotoXY(Xposn,Yposn+Item);        { Position to current choice    }
  113.       Get_Abs_Attr(Attr);              { Get Current Text Attributes   }
  114.       TextColor((Attr and $0F) or $08);{ Turn Bright Attr on           }
  115.       Textbackground(Black);
  116.       write(Item_List[Item]);          { Write Current Choice          }
  117.                                  { Get Keyboard and clear current pick }
  118.       Chval := Keyin;
  119.       If Chval <> Select Then          { Set current line to normal attr}
  120.                          begin
  121.                          GotoXY(Xposn,Yposn+Item);
  122.                          TextColor(Attr and $0F);
  123.                          Textbackground(Attr Shr 4);
  124.                          write(Item_List[Item]);
  125.                          end;
  126.       Case Chval of                      { Determine new Pick }
  127.          Select  :  Begin                { Set and remember this selection}
  128.                     Menu := Item;
  129.                     Last_Selected := Item;
  130.                     end;
  131.          Cancel  :  Menu := 0;
  132.          DownList:  Item := Item Mod Input_Items +1 ;
  133.          Uplist  :  Begin
  134.                     Item :=(Item-1) Mod Input_Items ;
  135.                     If (Item=0) then Item := Input_Items;
  136.                     end;
  137.          end;
  138.  
  139.     Until (Chval = Select) Or (Chval = Cancel)
  140.   End;
  141. {......................................................................}
  142.